; This program makes woodpipe templates for chest layouts.
; It calculates wall and cap thicknesses automatically. You will
; need to change the thickness formula to your standards.
; To run type -> (load "Place pipe template")
; rev May 30/93

(prompt (strcat (chr 13) (chr 10) "Loading Woodpipe template file..."))

(defun dtr (a) (* pi (/ a 180.0))); converts degrees to radians

;             Draws Template and Saves it as a Block
(defun maketemp     (pno / wpt1 wpt2 bn wallth capth halfdepth halfwidth)

   (setq wpt1       (polar pt (dtr 225.0) (* depth 2))
         wpt2       (polar pt (dtr 45.0)  (* depth 2))
         bn         (strcat mark "-" (itoa pno))
         th         (/ depth 7)

         halfdepth  (/ depth 2)
         halfwidth  (/ width 2)
   )
   ; define constants, (we use this formula for oak woodpipe thicknesses
   ; The 1.3 x for softwood is arbitrary, we don't use softwood.)

   (if (= Hardwood "Yes")
       (setq walltk        (* 0.51329 (expt depth 0.68828)))  ;hardwood 
       (setq walltk (* 1.3 (* 0.51329 (expt depth 0.68828)))) ;softwood
   )

   ; draw inside of cap
   (command "LAYER" "SET" "Pipe-Template" "")
   (command "line"
      (list (- (car pt) halfwidth walltk)  (+ (cadr pt) halfdepth))
      (list (+ (car pt) halfwidth walltk)  (+ (cadr pt) halfdepth))
   "")

   ; draw inside of backwall
   (command "line"
      (list (- (car pt) halfwidth walltk)  (- (cadr pt) halfdepth))
      (list (+ (car pt) halfwidth walltk)  (- (cadr pt) halfdepth))
   "")

   ; draw left inside of pipe
   (command "line"
      (list (- (car pt) halfwidth)  (+ (cadr pt) halfdepth))
      (list (- (car pt) halfwidth)  (- (cadr pt) halfdepth))
   "")

   ; draw right inside of pipe
   (command "line"
      (list (+ (car pt) halfwidth)  (+ (cadr pt) halfdepth))
      (list (+ (car pt) halfwidth)  (- (cadr pt) halfdepth))
   "")

   ; draw outside of pipe, (we make our caps 1.3x wall thickness)
   (command "line"
      (list (- (car pt) halfwidth walltk) (+ (cadr pt) halfdepth walltk))
      (list (+ (car pt) halfwidth walltk) (+ (cadr pt) halfdepth walltk))
      (list (+ (car pt) halfwidth walltk)
                                   (- (cadr pt) halfdepth (* 1.3 walltk)))
      (list (- (car pt) halfwidth walltk)
                                   (- (cadr pt) halfdepth (* 1.3 walltk)))
   "C")

   ; color the pipe outline
   (command "CHANGE" "WINDOW" wpt1 wpt2 "" "PROPERTIES" "COLOR" colour "")

   ; draw target
   (command "LAYER" "SET" "Pipe-Template-Center" "")
   (command "LINE"
      (list (- (car pt) 5)    (+ (cadr pt) 5))
      (list (+ (car pt) 5)    (- (cadr pt) 5))
   "")
   (command "LINE"
      (list (+(car pt) 5)     (+ (cadr pt) 5))
      (list (-(car pt) 5)     (- (cadr pt) 5))
   "")

   ; now we add some text
   (command "LAYER" "S" "Pipe-Template-Name" "")
   (command "STYLE" "TEMPLATE" "" th "" "" "" "" "")
   (command "TEXT" "C" (list (car pt) (+ (cadr pt) (/ depth 8))) "0" mark)
   (command "TEXT" "C" (list (car pt) (- (cadr pt) (/ depth 4))) "0" pno )   
   (command "LAYER" "SET" "0" "")

   ; and block it
   (command "BLOCK" bn pt "C" wpt1 wpt2 "")
)

(defun c:TEMPLATE ( )
;                    Variables:
   ; Mark	string	stop label
   ; pt		point	location to draw temporary templates
   ; tn		int	number of first   template
   ; tncur	int	number of current template
   ; tnxt  	int	number of next    template
   ; depth	real	depth of first template
   ; dnxt	real	depth of next  template
   ; width	real	width of first template
   ; wnxt	real	width of next  template
   ; factor	real	multiply by d to get next d
   ; wfactor    real    multiply by w to get next w
   ; th		real	height of lettering

   ;         Save Environment & Initialize
   (setq cmdechofound (getvar "CMDECHO")
         hilitefound  (getvar "HIGHLIGHT")
         osfound      (getvar "OSMODE")
         regenfound   (getvar "REGENMODE")
         clayerfound  (getvar "CLAYER")
   )
   (setvar "CMDECHO"   0)
   (setvar "OSMODE"    0)
   (setvar "REGENMODE" 0)
   (setvar "HIGHLIGHT" 0)

   ;          Get the First Template	
   (initget "Yes No")
   (setq hardwood (getkword"\nAre these pipes hardwood (Oak): Yes/No: "))
   (if (= Hardwood "Yes")
      (prompt "\nWood thicknesses will be for Hardwood (oak) pipes.")
      (prompt "\nWood thicknesses will be for Softwood (pipe) pipes.")
   )
   (setq mark   (getstring "\nEnter the name for this stop, up to 5 characters, eg: Ged8: ")
         colour (getstring "Color for this set: "))

   ;          Let's make sure we've got the layers 
   (command "STYLE" "TEMPLATE" "SIMPLEX" "1" ".75" "0" "" "" "")
   (command "LAYER" "N" "Pipe-Template"        "C" colour "Pipe-Template"        "T" "Pipe-Template-Center" "")
   (command "LAYER" "N" "Pipe-Template-Center" "C" colour "Pipe-Template-Center" "T" "Pipe-Template-Center" "")
   (command "LAYER" "N" "Pipe-Template-Name"   "C" Colour "Pipe-Template-Name"   "T" "Pipe-Template-Name" "T" "0" "S" "0"  "")

   (setq pt     (getpoint (strcat "Pick location on screen to build templates: " (chr 13) (chr 10)))
         tn     (getint "Number for first template: ")
         depth  (getreal (strcat "Inside Depth (in mm) for template number " (itoa tn) ": "))
         width  (getreal (strcat "Inside Width (in mm) for template number " (itoa tn) ": "))
   )
   (maketemp tn); make the first template 

   ;         Loop for the Remaining Templates
   (setq tnxt (getint "Number for next template: "))
   (while (not (equal tnxt nil))
      (setq dnxt    (getreal (strcat "Inside Depth (in mm) for template number " (itoa tnxt) ": "))
            factor  (expt (/ dnxt depth) (/ 1.0 (- (float tnxt) (float tn))))
            wnxt    (getreal (strcat "Inside Width (in mm) for template number " (itoa tnxt) ": "))
            wfactor (expt (/ wnxt width) (/ 1.0 (- (float tnxt) (float tn))))
            tncur   (+ tn 1)
      )
      (while (<= tncur tnxt)
         (setq depth (*  factor depth)
               width (* wfactor width))
         (maketemp tncur)
         (setq tncur (1+ tncur))
      )
      (setq tn tnxt)
      (setq tnxt (getint "Number for next template: "))
   )
   ; restore environment
   (command "LAYER" "SET" clayerfound "")
   (setvar "OSMODE"    osfound)
   (setvar "REGENMODE" regenfound)
   (setvar "HIGHLIGHT" hilitefound)
   (setvar "CMDECHO"   cmdechofound)
   (princ)
)

(prompt (strcat "loaded." (chr 13) (chr 10)))
(c:TEMPLATE)